Source data: https://www.dhs.wisconsin.gov/covid-19/data-101.htm, which updates at 2 PM CT daily.

La Crosse County

Row

New Daily Cases per 100K population

Risk level colors from https://globalepidemics.org/key-metrics-for-covid-suppression/. The 7-day rolling average is plotted as a black line. Daily new cases are plotted as gray columns.

Positive Test Rate

Positive test rate is the percentage of total reported tests for each 7-day rolling period that are positive.

---
title: "La Crosse County COVID-19 Data"
date: "`r format(Sys.time(), '%B %d, %Y')`"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: scroll
    source_code: embed
---

Source data: , which updates at 2 PM CT daily.

```{r setup, include=FALSE}
knitr::opts_chunk$set(
	echo = FALSE,
	message = FALSE,
	warning = FALSE
)
library(tidyverse)
library(jsonlite)
library(lubridate)
library(httr)
library(scales)
library(plotly)
library(flexdashboard)
```

```{r importData, echo = FALSE}
COVID_WI <- read_csv("https://opendata.arcgis.com/datasets/b913e9591eae4912b33dc5b4e88646c5_10.csv?where=GEO%20%3D%20%27County%27&outSR=%7B%22latestWkid%22%3A3857%2C%22wkid%22%3A102100%7D")
COVID_WI$DATE <- as.Date(COVID_WI$DATE)
COVID_WI <- COVID_WI %>%
  arrange(DATE)
```
```{r la_crosse_calcs, echo = FALSE}
COVID_LaCrosse <- COVID_WI %>%
  filter(NAME %in% "La Crosse")
COVID_LaCrosse <- COVID_LaCrosse %>%
  mutate(new_daily_avg_7 = 
           (lag(POS_NEW, n = 3) +
              lag(POS_NEW, n = 2) +
              lag(POS_NEW, n = 1) + 
              POS_NEW +
              lead(POS_NEW, n = 1) + 
              lead(POS_NEW, n = 2) +
              lead(POS_NEW, n = 3)) / 7)
la_crosse_pop <- 118016
COVID_LaCrosse <- COVID_LaCrosse %>%
  mutate(POS_AVG = new_daily_avg_7 * 100000 / la_crosse_pop)
COVID_LaCrosse <- COVID_LaCrosse %>%
  mutate(POS_NEW_100K = POS_NEW * 100000 / la_crosse_pop)

# calculate positive test ratio from 7-day rolling average of new cases
COVID_LaCrosse <- COVID_LaCrosse %>%
  mutate(POS_RATE = 
           (lag(POS_NEW, n = 3) +
              lag(POS_NEW, n = 2) +
              lag(POS_NEW, n = 1) + 
              POS_NEW +
              lead(POS_NEW, n = 1) + 
              lead(POS_NEW, n = 2) +
              lead(POS_NEW, n = 3)) / 
           (lag(TEST_NEW, n = 3) +
              lag(TEST_NEW, n = 2) +
              lag(TEST_NEW, n = 1) + 
              TEST_NEW +
              lead(TEST_NEW, n = 1) + 
              lead(TEST_NEW, n = 2) +
              lead(TEST_NEW, n = 3)) * 100)
```
La Crosse County
=================================================

Row 
---------------------------------------------------

### New Daily Cases per 100K population

```{r la_crosse_plot, echo = FALSE}
# plot timeline of new daily cases per 100k residents, with thresholds for green / yellow / orange / red as defined by: https://globalepidemics.org/key-metrics-for-covid-suppression/

min_date <- min(COVID_LaCrosse$DATE)
max_date <- max(COVID_LaCrosse$DATE)
max_lacrosse <- max(COVID_LaCrosse$POS_NEW_100K, na.rm = TRUE)

la_crosse_plot <- ggplot(COVID_LaCrosse, 
                         aes(x = DATE, y = POS_AVG)) +
  annotate("rect", xmin = min_date, xmax = max_date, ymin = 10, ymax = 25, fill = "orange", 
           alpha = .5) +
  annotate("rect", xmin = min_date, xmax = max_date, ymin = 1, ymax = 10, fill = "yellow", 
           alpha = .5) +
  annotate("rect", xmin = min_date, xmax = max_date, ymin = 25, 
           ymax = max_lacrosse + 5, fill = "red", 
           alpha = .5) +
  annotate("rect", xmin = min_date, xmax = max_date, ymin = 0, ymax = 1, fill = "green", 
           alpha = .5) +
  geom_col(aes(y = POS_NEW_100K), fill = "gray80",
           na.rm = TRUE) +
  geom_line(color = "black", na.rm = TRUE) + 
  scale_y_continuous(limits = c(0, NA),
                     expand = c(0, 0)) +
  scale_x_date(date_breaks = "1 month", date_labels = "%b %d", 
               expand = c(0, 0)) +
  xlab("Date") + 
  ylab("Daily Cases per 100k Pop") + 
  theme_light(base_size = 15) + 
  theme(panel.grid = element_line(color = "gray95"))

la_crosse_plotly <- ggplotly(p = (la_crosse_plot))

la_crosse_plotly
```

> Risk level colors from . The 7-day rolling average is plotted as a black line. Daily new cases are plotted as gray columns.

### Positive Test Rate

```{r la_crosse_test_percent, echo=FALSE}
la_crosse_test_percent <- ggplot(COVID_LaCrosse,
                           aes(x = DATE, y = POS_RATE)) +
  annotate("rect", xmin = min_date, xmax = max_date, ymin = 5, ymax = 10, fill = "orange", 
           alpha = .5) +
  annotate("rect", xmin = min_date, xmax = max_date, ymin = 3, ymax = 5, fill = "yellow", 
           alpha = .5) +
  annotate("rect", xmin = min_date, xmax = max_date, ymin = 10, 
           ymax = 100, fill = "red", 
           alpha = .5) +
  annotate("rect", xmin = min_date, xmax = max_date, ymin = 0, ymax = 3, fill = "green", 
           alpha = .5) +
  geom_line(color = "black", na.rm = TRUE) + 
  scale_y_continuous(limits = c(0, 100),
                     expand = c(0, 0)) +
  scale_x_date(date_breaks = "1 month", date_labels = "%b %d", 
               expand = c(0, 0)) +
  xlab("Date") + 
  ylab("Positive Test Rate (%)") + 
  theme_light(base_size = 15) + 
  theme(panel.grid = element_line(color = "gray95"))

la_crosse_plotly_pos_rate <- ggplotly(p = (la_crosse_test_percent))

la_crosse_plotly_pos_rate
```

> Positive test rate is the percentage of total reported tests for each 7-day rolling period that are positive.